home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / dev / c / AmiVoGL_MDEV.lha / examples / fmoretxt.for < prev    next >
Text File  |  1991-06-03  |  3KB  |  218 lines
  1. c
  2. c drawgr
  3. c
  4. c    draw a grid in the middle of the screen
  5. c
  6.     subroutine drawgr
  7.  
  8. $INCLUDE: 'fvogl.h'
  9.  
  10.     real x
  11.  
  12.  
  13.     call color(GREEN)
  14.  
  15.     call rect(0.1, 0.4, 0.9, 0.6)
  16.  
  17.     x = 0.2
  18.  
  19.     do 10 i = 1, 8
  20.         call move2(x, 0.4)
  21.         call draw2(x, 0.6)
  22.         x = x + 0.1
  23. 10    continue
  24.  
  25.     call move2(0.1, 0.5)
  26.     call draw2(0.9, 0.5)
  27.  
  28.     call color(YELLOW)
  29.  
  30.     end
  31.  
  32. c
  33. c demonstrate some more features of text
  34. c
  35.     program    fmtxt
  36.  
  37. $INCLUDE: 'fvogl.h'
  38. $INCLUDE: 'fvodevic.h'
  39.  
  40.     character fname*80
  41.     integer *2 val
  42.  
  43.     print*,'Enter a font name:'
  44.     read(*,'(a)') fname
  45.  
  46.     call prefsi(512, 512)
  47.     call winope('fmoretxt', 8)
  48.  
  49. c
  50. c We are interested in Keyboard events...
  51. c
  52.     call unqdev(INPUTC)
  53.     call qdevic(KEYBD)
  54.  
  55.     call hfont(fname, nchars(fname))
  56.  
  57.     call ortho2(0.0, 1.0, 0.0, 1.0)
  58.  
  59.     call color(BLACK)
  60.     call clear
  61.  
  62.     call drawgr
  63.  
  64. c
  65. c show some scaled text on the grid (In the bottom part)
  66. c
  67.     call hboxte(0.1, 0.4, 0.8, 0.1,
  68.      +      '{This is Some text] | $', 23)
  69.  
  70.     idum = qread(val)
  71.  
  72.     call color(BLACK)
  73.     call clear
  74.  
  75.     call drawgr
  76.  
  77. c
  78. c centertext causes text to be centered around the current graphics
  79. c position this is especially usefull if you want your text to come
  80. c out centered on a line, or a character to be centered on a point
  81. c in a graph. A non-zero (.true.) argument turns centertext on.
  82. c
  83. c show a string centered on the center line
  84. c
  85.     call hcente(.true.)
  86.  
  87.     call hboxte(0.5, 0.5, 0.8, 0.1,
  88.      +      '{This is Some Centered text] | $', 31)
  89. c
  90. c turn centertext off. We use an argument with the value zero (.false.).
  91. c
  92.     call hcente(.false.)
  93.  
  94.     idum = qread(val)
  95.  
  96.     call color(BLACK)
  97.     call clear
  98.  
  99. c
  100. c rotate the grid so that it is the same angle as the text after
  101. c textang for text ang.
  102. c
  103.     call pushma
  104.         call transl(0.5, 0.5, 0.0)
  105.         call rotate(900, 'z')
  106.         call transl(-0.5, -0.5, 0.0)
  107.  
  108.         call drawgr
  109.     call popmat
  110.  
  111. c
  112. c turn on centered text again
  113. c
  114.     call hcente(.true.)
  115.  
  116. c
  117. c set the angle to 90.
  118. c
  119.     call htexta(90.0)
  120.  
  121. c
  122. c draw the string
  123. c
  124.     call htexts(0.05, 0.05)
  125.     call hboxte(0.5, 0.5, 0.8, 0.1,
  126.      +      '{This is Some Rotated Centered text] | $', 39)
  127. c
  128. c turn off center text
  129. c
  130.     call hcente(.false.)
  131.  
  132. c
  133. c set text angle back to 90
  134. c
  135.     call htexta(0.0)
  136.  
  137.     idum = qread(val)
  138.  
  139.     call color(BLACK)
  140.     call clear
  141.  
  142.     call drawgr
  143.  
  144. c
  145. c as all the software fonts are proportionally spaced we use
  146. c the fixedwidth call to make each character take the same amount
  147. c of horizontal space. As with centertext this is done by passing
  148. c fixedwidth a non-zero (.true.) argument.
  149. c
  150.     call hfixed(.true.)
  151.  
  152.     call hboxte(0.1, 0.5, 0.8, 0.1,
  153.      +      '{This is Some Fixedwidth text] | $', 33)
  154.  
  155.     idum = qread(val)
  156.  
  157.     call color(BLACK)
  158.     call clear
  159.  
  160.     call drawgr
  161.  
  162. c
  163. c now try centered and fixewidth at the same time
  164. c
  165.     call hcente(.true.)
  166.  
  167.     call move2(0.5, 0.5)
  168.     call hchars('{This is Some Cent.Fixedwidth text] | $', 38)
  169.  
  170.     call hcente(.false.)
  171.     
  172.     idum = qread(val)
  173.     call color(BLACK)
  174.     call clear
  175.  
  176.     call drawgr
  177.  
  178. c
  179. c scale the text so tha a character is the size of a box in
  180. c the grid.
  181. c
  182.     call hboxfi(0.8, 0.1, 8)
  183.  
  184. c
  185. c draw the two strings fixedwidth (it is still turned on)
  186. c
  187.     call move2(0.1, 0.4)
  188.     call hchars('ABCDefgh', 8)
  189.  
  190.     call move2(0.1, 0.5)
  191.     call hchars('IJKLmnop', 8)
  192.  
  193.     idum = qread(val)
  194.  
  195.     call gexit
  196.  
  197.     end
  198. c
  199. c nchars
  200. c
  201. c return the real length of a string padded with blanks
  202. c
  203.     integer function nchars(str)
  204.     character *(*) str
  205.  
  206.     do 10 i = len(str), 1, -1
  207.         if (str(i:i) .ne. ' ') then
  208.             nchars = i
  209.             return
  210.         end if
  211. 10      continue
  212.  
  213.     nchars = 0
  214.  
  215.     return
  216.  
  217.     end
  218.